home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / grep.tcl < prev    next >
Text File  |  1997-04-04  |  4KB  |  142 lines
  1. #================================================================================
  2. # 'greplist' and 'grepfset' are used for batch searching from the "find" dialog.
  3. #  Hence, you really shouldn't mess with them unless you know what you are doing.
  4. #================================================================================
  5. proc greplist {args} {
  6.     global tileLeft tileTop tileWidth tileHeight errorHeight
  7.  
  8.     set recurse [car $args]
  9.     set word [cadr $args]
  10.     set args [cddr $args]
  11.     
  12.     set num [expr [llength $args] - 2]
  13.     set exp [lindex $args $num]
  14.     set arglist [lindex $args [expr $num + 1]]
  15.     
  16.     set opened 0
  17.     set owin 0
  18.     set cid [scancontext create]
  19.  
  20.     set cmd [lrange $args 0 [expr $num - 1]]
  21.     eval scanmatch $cmd {$cid $exp {
  22.         if {!$word || [regexp -nocase "(^|\[^a-zA-Z0-9\])${exp}(\[^a-zA-Z0-9\]|\$)" $matchInfo(line)]} {
  23.             if (!$owin) {
  24.                 set owin 1
  25.                 new -n {* Batch Find *} -g $tileLeft $tileTop $tileWidth $errorHeight
  26.  
  27.                 global winModes
  28.                 set name [lindex [winNames] 0]
  29.                 changeMode [set winModes($name) Brws]
  30.  
  31.                 insertText "(<cr> to go to match)\r-----\r"
  32.                 set w [car [winNames -f]]
  33.                 set opened 1
  34.             }
  35.             set l [expr 20 - [string length [file tail $f]]]
  36.             insertText -w $w "\"[file tail $f]\"[format "%$l\s" ""]; Line $matchInfo(linenum): $matchInfo(line)\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"}
  37.         }
  38.     }
  39.  
  40.     foreach f $arglist {
  41.         message [file tail $f]
  42.         if {![catch {set fid [open $f]}]} {
  43.             scanfile $cid $fid
  44.             close $fid
  45.         }
  46.     }
  47.     scancontext delete $cid
  48.  
  49.     if {$opened} {
  50.         select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
  51.         setWinInfo dirty 0
  52.         setWinInfo read-only 1
  53.     }
  54.     message ""
  55. }
  56.  
  57. proc grepfset {args} {
  58.     set num [expr [llength $args] - 2]
  59.     set exp [lindex $args $num]
  60.     set fset [lindex $args [expr $num + 1]]
  61.     eval greplist 0 [lrange $args 0 [expr $num-1]] {$exp [getFileSet $fset]}
  62. }
  63.  
  64. proc grep {exp args} {
  65.     set files {}
  66.     foreach arg $args {
  67.         if {![catch {glob -t TEXT $arg} lst]} {
  68.             append files " " $lst
  69.         }
  70. #         if {![catch {glob -t ttro $arg} lst]} {
  71. #             append files " " $lst
  72. #         }
  73.     }
  74.     if {$files==""} {return $lst}
  75.     set cid [scancontext create]
  76.     scanmatch $cid $exp {
  77.         if {!$blah} {
  78.             set blah 1
  79.             set lines "(<cr> to go to match)\r"
  80.         }
  81.         set l [expr 20 - [string length [file tail $f]]]
  82.         append lines "\"[file tail $f]\"[format "%$l\s" ""]; Line $matchInfo(linenum): $matchInfo(line)\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"
  83.     }
  84.  
  85.     set blah 0
  86.     set lines ""
  87.  
  88.     foreach f $files {
  89.         if {![catch {set fid [open $f]}]} {
  90.             message [file tail $f]
  91.             scanfile $cid $fid
  92.             close $fid
  93.         }
  94.     }
  95.     scancontext delete $cid
  96.     return [string trimright $lines "\r"]
  97. }
  98.  
  99.  
  100. #===============================================================================
  101.  
  102. set lastMatchingLines ""
  103.  
  104. proc matchingLines {{reg ""} {for 1} {ign 1} {word 0} {regexp 1}} {
  105.     global lastMatchingLines tileLeft tileTop tileWidth errorHeight
  106.     
  107.     if {![string length $reg] && [catch {prompt "Regular expression:" $lastMatchingLines} reg]} return
  108.     set lastMatchingLines $reg
  109.     if {![string length $reg]} return
  110.     if {!$regexp} {
  111.         set reg [quoteExpr2 $reg]
  112.         regsub -all {\\\\} $reg {\\} reg
  113.     }
  114.     if $word {
  115.         set reg "^.*\\b$reg\\b.*$"
  116.     } else {
  117.         set reg "^.*$reg.*$"
  118.     }
  119.     set pos [expr $for ? 0 : [getPos]]
  120.     set fileName [car [winNames -f]]
  121.     set matches 0
  122.     set lines {}
  123.     while {![catch {search -s -f 1 -r 1 -i $ign $reg $pos} mtch]} {
  124.         append lines "\r" [format "Line %d: " [lindex [posToRowCol [lindex $mtch 0]] 0]] [eval getText $mtch] "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fileName"
  125.         set pos [lindex $mtch 1]
  126.         incr matches
  127.     }
  128.     new -n {* Matching Lines *} -g $tileLeft $tileTop $tileWidth $errorHeight
  129.     insertText [format "%d matching lines (<cr> to go to match)\r-----" $matches] $lines "\r"
  130.     select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
  131.     
  132.     global winModes
  133.     set name [lindex [winNames] 0]
  134.     changeMode [set winModes($name) Brws]
  135.     setWinInfo dirty 0
  136.     setWinInfo read-only 1
  137. }
  138.  
  139. proc findBatch {forward ignore regexp word pat} {
  140.     matchingLines $pat $forward $ignore $word $regexp 
  141. }
  142.